home *** CD-ROM | disk | FTP | other *** search
Oberon Text | 1995-05-15 | 7.9 KB | 205 lines | [TEXT/.Ob4] |
- Syntax10.Scn.Fnt
- Syntax10b.Scn.Fnt
- MODULE ErrorElems; (** CAS 28-Oct-91 / MH 28-Sep-1993**)
- IMPORT
- Display, Input, Files, Fonts, Printer, Oberon, Texts, Viewers, MenuViewers, TextFrames, TextPrinter;
- CONST
- ErrFile = "OberonErrors.Text";
- ErrFont = "Syntax8.Scn.Fnt"; (* MH: may be changed to any font *)
- mm = TextFrames.mm;
- CR = 0DX;
- middleKey = 1; leftKey = 2;
- TYPE
- Elem* = POINTER TO ElemDesc;
- ElemDesc* = RECORD(Texts.ElemDesc)
- err*: INTEGER;
- msg*: ARRAY 128 OF CHAR;
- expanded: BOOLEAN;
- END;
- font*: Fonts.Font;
- W: Texts.Writer;
- lastTime: LONGINT;
- PROCEDURE MarkedFrame (): TextFrames.Frame;
- VAR V: Viewers.Viewer;
- BEGIN V := Oberon.MarkedViewer();
- IF (V IS MenuViewers.Viewer) & (V.dsc.next IS TextFrames.Frame) THEN RETURN V.dsc.next(TextFrames.Frame)
- ELSE RETURN NIL
- END
- END MarkedFrame;
- PROCEDURE Show (F: TextFrames.Frame; pos: LONGINT);
- VAR beg, end, delta: LONGINT;
- BEGIN delta := 200;
- LOOP beg := F.org; end := TextFrames.Pos(F, F.X, F.Y);
- IF (beg <= pos) & (pos < end) OR (beg = end) THEN EXIT END;
- TextFrames.Show(F, pos - delta); DEC(delta, 20)
- END
- END Show;
- PROCEDURE IntToStr (x: LONGINT; VAR s: ARRAY OF CHAR);
- VAR i, j: INTEGER; str: ARRAY 10 OF CHAR;
- BEGIN i := 0; j := 0;
- REPEAT str[i] := CHR((x MOD 10) + ORD("0")); x := x DIV 10; INC(i) UNTIL x = 0;
- REPEAT DEC(i); s[j] := str[i]; INC(j) UNTIL i = 0;
- s[j] := 0X;
- END IntToStr;
- PROCEDURE Width (E: Elem): INTEGER;
- VAR fnt: Fonts.Font; pat: Display.Pattern; i, px, dx, x, y, w, h: INTEGER;
- BEGIN fnt := Fonts.This(ErrFont); i := 0; px := 0;
- WHILE E.msg[i] # 0X DO
- Display.GetChar(fnt.raster, E.msg[i], dx, x, y, w, h, pat); INC(px, dx); INC(i)
- END;
- RETURN px + 6
- END Width;
- PROCEDURE ShowErrMsg* (E: Elem; F: Display.Frame; col: SHORTINT; x0, y0, dw: INTEGER);
- VAR fnt: Fonts.Font; pat: Display.Pattern; i, px, rm, dx, x, y, w, h: INTEGER; ch: CHAR;
- BEGIN fnt := Fonts.This(ErrFont); i := 0; px := x0 + 3; rm := x0 + dw - 3;
- LOOP ch := E.msg[i]; INC(i);
- IF ch = 0X THEN EXIT END;
- Display.GetChar(fnt.raster, ch, dx, x, y, w, h, pat);
- IF px + dx > rm THEN EXIT END;
- Display.CopyPattern(col, pat, px + x, y0 + y, Display.invert); INC(px, dx)
- END
- END ShowErrMsg;
- PROCEDURE Expand* (E: Elem; pos: LONGINT);
- VAR S: Texts.Scanner; T: Texts.Text; n, m: INTEGER; ch: CHAR;
- BEGIN
- NEW(T); Texts.Open(T, ErrFile); Texts.OpenScanner(S, T, 0);
- REPEAT S.line := 0;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
- UNTIL S.eot OR (S.class = Texts.Int) & (S.i = E.err);
- IF ~S.eot THEN Texts.Read(S, ch); n := 0;
- WHILE ~S.eot & (ch # CR) & (n + 1 < LEN(E.msg)) DO E.msg[n] := ch; INC(n); Texts.Read(S, ch) END;
- E.msg[n] := 0X; E.W := LONG(Width(E)) * TextFrames.Unit;
- TextFrames.NotifyDisplay(Texts.ElemBase(E), Texts.replace, pos, pos+1)
- END;
- E.expanded := TRUE;
- END Expand;
- PROCEDURE Reduce* (E: Elem; pos: LONGINT);
- BEGIN
- E.W := 3 * mm; IntToStr(E.err, E.msg); E.W := LONG(Width(E)) * TextFrames.Unit;
- TextFrames.NotifyDisplay(Texts.ElemBase(E), Texts.replace, pos, pos+1);
- E.expanded := FALSE;
- END Reduce;
- PROCEDURE Delete* (E: Elem; pos: LONGINT);
- VAR T: Texts.Text;
- BEGIN T := Texts.ElemBase(E);
- IF T # NIL THEN Texts.Delete(T, pos, pos + 1) END
- END Delete;
- PROCEDURE Copy* (SE, DE: Elem);
- BEGIN Texts.CopyElem(SE, DE); DE.err := SE.err; DE.msg := SE.msg; DE.expanded := SE.expanded;
- END Copy;
- PROCEDURE Prepare* (E: Elem; fnt: Fonts.Font; VAR voff: INTEGER);
- VAR max: INTEGER;
- BEGIN
- IF font.height > fnt.height THEN max := font.height ELSE max := fnt.height END;
- E.H := LONG(max+1) * TextFrames.Unit;
- voff := fnt.minY;
- END Prepare;
- PROCEDURE Disp* (E: Elem; F: Display.Frame; col: SHORTINT; fnt: Fonts.Font; x0, y0: INTEGER);
- VAR w, h: INTEGER;
- BEGIN w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit);
- Display.ReplConst(15, x0, y0 , w , h, Display.replace);
- IF E.msg[0] # 0X THEN ShowErrMsg(E, F, col, x0, y0 - fnt.minY, w) END
- END Disp;
- PROCEDURE Print* (E: Elem; x0, y0: INTEGER);
- VAR w, h: INTEGER;
- BEGIN w := SHORT(E.W DIV TextPrinter.Unit); h := SHORT(E.H DIV TextPrinter.Unit);
- Printer.ReplConst(x0 + 1, y0 + 2, w - 2, h)
- END Print;
- PROCEDURE Edit* (E: Elem; pos: LONGINT; x0, y0, x, y: INTEGER; keysum: SET);
- VAR w, h: INTEGER; keys: SET;
- BEGIN
- IF keysum = {middleKey} THEN
- w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit);
- Oberon.RemoveMarks(x0, y0, w, h);
- Display.ReplConst(15, x0 + 2 , y0 + 2, w - 4, h - 4, Display.invert);
- REPEAT Input.Mouse(keys, x, y); keysum := keysum + keys;
- Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y);
- UNTIL keys = {};
- Display.ReplConst(15, x0 + 2, y0 + 2, w - 4, h - 4, Display.invert);
- IF keysum = {middleKey} THEN
- IF E.expanded THEN Reduce(E, pos) ELSE Expand(E, pos) END
- END
- END
- END Edit;
- PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
- VAR e: Elem; pos: LONGINT; w, h: INTEGER; keys, keysum: SET;
- BEGIN
- WITH E: Elem DO
- IF msg IS TextFrames.DisplayMsg THEN
- WITH msg: TextFrames.DisplayMsg DO
- IF ~msg.prepare THEN Disp(E, msg.frame, msg.col, msg.fnt, msg.X0, msg.Y0)
- ELSE Prepare (E, msg.fnt, msg.Y0)
- END
- END
- ELSIF msg IS TextPrinter.PrintMsg THEN
- WITH msg: TextPrinter.PrintMsg DO
- IF ~msg.prepare THEN Print(E, msg.X0, msg.Y0) END
- END
- ELSIF msg IS Texts.CopyMsg THEN
- NEW(e); Copy(E, e); msg(Texts.CopyMsg).e := e;
- ELSIF msg IS TextFrames.TrackMsg THEN
- WITH msg: TextFrames.TrackMsg DO
- Edit(E, msg.pos, msg.X0, msg.Y0, msg.X, msg.Y, msg.keys)
- END
- END
- END
- END Handle;
- PROCEDURE InsertAt* (T: Texts.Text; pos: LONGINT; err: INTEGER);
- VAR e: Elem;
- BEGIN NEW(e); e.H := LONG(font.height + 2) * TextFrames.Unit; e.handle := Handle;
- e.err := err;
- IntToStr(err, e.msg); e.W := LONG(Width(e)) * TextFrames.Unit; e.expanded := FALSE;
- Texts.WriteElem(W, e); Texts.Insert(T, pos, W.buf)
- END InsertAt;
- PROCEDURE Unmark*;
- VAR F: TextFrames.Frame; pos: LONGINT; R: Texts.Reader;
- BEGIN F := MarkedFrame();
- IF F # NIL THEN
- Texts.OpenReader(R, F.text, 0); Texts.ReadElem(R);
- WHILE ~R.eot DO
- IF R.elem IS Elem THEN pos := Texts.Pos(R); Texts.Delete(F.text, pos-1, pos);
- Texts.OpenReader(R, F.text, pos-1)
- END;
- Texts.ReadElem(R)
- END
- END
- END Unmark;
- PROCEDURE Mark*;
- VAR F: TextFrames.Frame; S: Texts.Scanner; T: Texts.Text;
- text: Texts.Text; beg, end, time, pos, delta: LONGINT; err: INTEGER;
- BEGIN Unmark; F := MarkedFrame(); Oberon.GetSelection(text, beg, end, time); delta := 0;
- IF (F # NIL) & (time >= lastTime) THEN
- lastTime := time; T := F.text; Texts.OpenScanner(S, text, beg);
- LOOP S.line := 0;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
- IF S.eot OR (S.line # 0) THEN EXIT END;
- pos := S.i;
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0) OR (S.class = Texts.Int);
- IF S.eot OR (S.line # 0) THEN EXIT END;
- err := SHORT(S.i); InsertAt(T, pos + delta, err); INC(delta);
- REPEAT Texts.Scan(S) UNTIL S.eot OR (S.line # 0)
- END
- END
- END Mark;
- PROCEDURE LocateNext*;
- VAR F: TextFrames.Frame; beg, pos: LONGINT; R: Texts.Reader;
- BEGIN F := MarkedFrame();
- IF F # NIL THEN
- IF F.hasCar THEN beg := F.carloc.pos ELSE beg := 0 END;
- Texts.OpenReader(R, F.text, beg);
- REPEAT Texts.ReadElem(R) UNTIL R.eot OR (R.elem IS Elem);
- IF ~R.eot & (R.elem IS Elem) THEN
- Oberon.PassFocus(Viewers.This(F.X, F.Y)); pos := Texts.Pos(R);
- Show(F, pos-1); TextFrames.SetCaret(F, pos)
- ELSE TextFrames.RemoveCaret(F)
- END
- END
- END LocateNext;
- BEGIN
- font := Fonts.This(ErrFont);
- Texts.OpenWriter(W); lastTime := -1;
- END ErrorElems.
- ErrorElems.Mark ^
- ErrorElems.Unmark *
- ErrorElems.LocateNext
-